{
======================================================================
Project  : Firebird Control Center
Unit     : uBrowseDir.pas
Purpose  : Enhanced SelectDirectory function
Author   : Achim Kalwa <delphi@achim-kalwa.de>
Compiler : Borland Delphi 5.01
======================================================================
}
{$I fbcc.inc}
unit uBrowseDir;

interface

uses
  Windows,
  Classes,
  SysUtils,
  Forms;

function SelectDirectoryEx(const Caption: string; const Root, Start: WideString;
  out Directory: string): Boolean;

implementation

uses
  FileCtrl,
  ShlObj,
  ActiveX;

const
  BIF_NEWDIALOGSTYLE     = $0040;
  BIF_BROWSEINCLUDEURLS  = $0080;
  BIF_SHAREABLE          = $8000;
  BIF_USENEWUI           = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;

var
  sStartDir : string;

function FuncBrowseCallback(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
var
  Buffer : array[0..MAX_PATH] of Char;
begin
  case uMsg of
    BFFM_INITIALIZED:
      begin
        SendMessage(Wnd, BFFM_SETSELECTION, 1, Longint(PChar(sStartDir)));
      end;

    BFFM_SELCHANGED:
      begin
        if SHGetPathFromIDList(PItemIDList(lParam), Buffer)
        then SendMessage(Wnd, BFFM_SETSTATUSTEXT, 0, Integer(@Buffer));
      end;
  end;
  Result := 0;
end;

function SelectDirectoryEx(const Caption: string; const Root, Start: WideString;
  out Directory: string): Boolean;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
begin
  Result := False;
  sStartDir := Start;
  Directory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if Root <> '' then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end;
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
        lpfn := FuncBrowseCallback;
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := SHBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result :=  ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

end.
